COMMENT ⊗   VALID 00014 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	ENTRY IINFINT,IFNDMSK,IREGSTA,IAVER,IBOXNM,IBORDERFOLLOW,IMARK,
C00005 00003	! Procedure that returns a buffer of the given mask if it exists
C00007 00004	! Procedure to calculate the mean and standard deviation over a
C00009 00005	! Procedure to calculate the mean and standard deviation of a mask given the
C00012 00006	IFCR FALSE THENC
C00013 00007	SIMPLE INTERNAL BOOLEAN PROCEDURE IBORDERFOLLOW(INTEGER IBUFPROCEDURE DOTHIS)
C00014 00008	 WHEN THIS PROCEDURE  IS GIVEN TWO POINTS  (X1,Y1) & (X2,Y2),
C00016 00009	! Procedure to make a picture buffer of a region with the outside in 2's,
C00017 00010	! Procedure to zero out a portion of buf1 with buf2 and delete buf2
C00018 00011	! Procedure to make a mask of ones for a region.  It is passed
C00019 00012	! Procedure to make masks out of each separate mask that is found in
C00020 00013	! Procedure to join two masks out right and returns a third buffer
C00021 00014	REQUIRE UNSTACK!DELIMITERS
C00022 ENDMK
C⊗;
ENTRY IINFINT,IFNDMSK,IREGSTA,IAVER,IBOXNM,IBORDERFOLLOW,IMARK,
	IMSKTMP,IZEROUT,IMSKREG,IMAKMSK,ISEPMSK,ICONMSK,IJNMSK,
	IREGJN;
BEGIN "INFBAS"
REQUIRE "36A" COMPILER!SWITCHES;
REQUIRE "MURLIB.DCL" SOURCE!FILE;
REQUIRE "BUFDEC.SAI" SOURCE!FILE;
SOURCE!V(EXTITM);
REQUIRE "⊂⊃<>" DELIMITERS;

! This is a module of procedures for manipulating masks and
  picture buffers used by programs that use DATBAS.
  Greg Lawson   June 9, 1975
  TENEX VERSION DELETED LOTS OF ROUTINES.
  KEITH ZPRICE FEB 1977.
 Procedure to initialize this module;
SIMPLE INTERNAL PROCEDURE IINFINT;
	BEGIN "IINFINT"
	IF ¬IROWS THEN IROWS←600;
	IF ¬ICOLMS THEN ICOLMS←800;
	if imskext=null then imskext←"MSK";
	END "IINFINT";
! Procedure that returns a buffer of the given mask if it exists
  else it returns -1.
;
SIMPLE INTERNAL INTEGER PROCEDURE IFNDMSK(ITEMVAR PROPERTY;STRING ITEMVAR REGION);
	BEGIN "IFNDMSK"
	IFC TRUE THENC RETURN(-1);
	ELSEC
	STRING ITEMVAR STRVAR;
	INTEGER CHAN,FLG,BUF,LOC;
	STRING MSKFIL,SDUM,DEV;
	INTEGER ARRAY ITEMVAR ARRVAR;
	IF ¬(PROPERTY⊗REGION≡BIND STRVAR) THEN 
		BEGIN
		OUTST("INFBAS: IFNDMSK: No mask name found for "&cvs(props(region))&crlf);
		RETURN(-1);
		end;
	MSKFIL←DATUM(STRVAR);
	DEV←GETDEV(MSKFIL,IMSKEXT);
	
	BUF←FNDBUF;
	if buf=-1 then
		begin
		outst("INFBAS: IFNDMSK: Ran out of picture buffers"&crlf);
		return(-1);
		end;
	INDMP(DEV,MSKFIL,BUF,FLG←-2);
	IF FLG THEN RETURN(-1) ELSE RETURN(BUF);
	ENDC
	END "IFNDMSK";
! Procedure to calculate the mean and standard deviation over a
  region of points in a buffer as defined by a mask.
  And returns the number of points that it averaged over.
;
SIMPLE INTERNAL INTEGER PROCEDURE IREGSTA(INTEGER FILBUF,RBUF; REFERENCE REAL MEAN,STANDEV);
	BEGIN "IREGSTA"
	INTEGER NUMBER,RPTR,FPTR,ROWZ,COLMZ,RPNT,FPNT,I,J,FLG,IC,JC,SUM2,SUM,IS,JS;
	ROWZ←ROWS(RBUF);
	COLMZ←COLMS(RBUF);
	IC←ISUBST(RBUF)-ISUBST(FILBUF);
	JC←JSUBST(RBUF)-JSUBST(FILBUF)+1;
	SUM2←SUM←NUMBER←0;
	FOR I←1 THRU ROWZ DO 
		BEGIN
		RPTR←INPTR(I,1,RBUF);
		FPTR←INPTR(I+IC,JC,FILBUF);
		FOR J←1 THRU COLMZ DO 
			IF ILDB(RPTR) THEN 
				BEGIN
				NUMBER←NUMBER+1;
				SUM←SUM+(FPNT←ILDB(FPTR));
				SUM2←SUM2+FPNT*FPNT;
				END
			    ELSE IBP(FPTR);
		END;
	MEAN←SUM/NUMBER;
	STANDEV←SQRT(SUM2/NUMBER-MEAN*MEAN);
	RETURN(NUMBER);
	END "IREGSTA";
! Procedure to calculate the mean and standard deviation of a mask given the
  Region, MSKBUF and FILBUF.  It multiplies the results by FAC (which as a default
  of 1 if is equal to 0).  The mean is stored in the left half of an integer and
  the STD is stored in the left half.   This integer is stored in the datum of a
  new item and a DWRITE(property,region,item) is done.  If mskbuf is set to -1 then
  the procedure will try to find the mask.  If something goes wrong FLG will be
  set.  No checking for getpnts in FILBUF is done.  It also does a
  DWRITE(dsize,region,dnew(size)).  MSKBUF will contain the mask buffer.
;
SIMPLE INTERNAL PROCEDURE IAVER(ITEMVAR PROPERTY;STRING ITEMVAR REGION;REAL FAC;INTEGER FILBUF; REFERENCE INTEGER MSKBUF,FLG);
	BEGIN "IAVER"
	INTEGER PNTS,NUM1,NUM2;
	REAL MEAN,STD,SIZE;
	FLG←0;
!	IF MSKBUF=-1 THEN MSKBUF←IFNDMSK(DMASK,REGION);
	IF MSKBUF=-1 THEN
		BEGIN
		FLG←-1;
		RETURN;
		END;
	IF FAC=0 THEN FAC←1;
	PNTS←IREGSTA(FILBUF,MSKBUF,MEAN,STD);
	IFC FALSE THENC
	SIZE←PNTS/(IROWS*ICOLMS);
	IF DFULL THEN
		BEGIN
		FLG←-1;
		OUTST("INFBAS: IAVER: Ran out of items"&crlf);
		RETURN;
		END;
	DWRITE(DSIZE,REGION,DNEW(SIZE));
	ENDC
	NUM1←MEAN*FAC;
	NUM2←STD*FAC;
	IF DFULL THEN
		BEGIN
		FLG←-1;
		OUTST("INFBAS: IAVER: Ran out of items"&crlf);
		RETURN;
		END;
	DWRITE(PROPERTY,REGION,DNEW((NUM1 LSH 18)+NUM2));
	END "IAVER";
IFCR FALSE THENC
! Procedure to return the sum of the values of all points in a box with the given
  point at the center of the box (where the point is relative to ISUBST,JSUBST) and
  the box having sides of size 2*SIZE+1.  If FLG is set then checking will be done
  and any point not on the buffer will be considered equal to zero.
;
SIMPLE INTERNAL INTEGER PROCEDURE IBOXNM(INTEGER BUF,I,J,SIZE,FLG);
	BEGIN "IBOXNM"
	RETURN(0);
	END "IBOXNM";
ENDC
SIMPLE INTERNAL BOOLEAN PROCEDURE IBORDERFOLLOW(INTEGER IBUF;PROCEDURE DOTHIS);
	RETURN(0);
COMMENT  WHEN THIS PROCEDURE  IS GIVEN TWO POINTS  (X1,Y1) & (X2,Y2),
        THE PICTURE BUFFER NO. ("BBFUFNO"), THE NUMBER OF ROWS IN THE
        BUFFER  ("ROWNUM"),  AND AN  INTENSITY  ("VAL"),  THE  POINTS
        CLOSEST TO  THE LINE  SEGMENT ARE  IMARKED WITH  "VAL" IN  THE
        BUFFER.   NOTE:  THAT  THE  TWO  POINTS  THAT  ARE  GIVEN  AS
        PARAMETERS ARE FOR A  PICTURE THAT HAS ITS LEFT BOTTOM CORNER
        AT (0,0) IN A  RIGHT COORDINATE SYSTEM, WHILE THE BUFFER THAT
        IS BEING IMARKED HAS  ITS POSITIONS ORDERED BY ROWS,COLUMNS AS
        I,J AND  (I,J)=(1,1) IS IN THE UPPER  LEFT HAND CORNER.  THIS
        TRANSLATION IS DONE AUTOMATICALLY BY THE PROCEDURE;

SIMPLE INTERNAL PROCEDURE IMARK(INTEGER X1,Y1,X2,Y2,ROWNUM,COLUMNS,BBUFNO,VAL);
    RETURN;
! Procedure to make a picture buffer of a region with the outside in 2's,
  the inside in 0's and the border in 1's.  Returns -99 if it can't do it;

SIMPLE INTERNAL INTEGER PROCEDURE IMSKTMP(STRING ITEMVAR XREG);
	RETURN(-1);
! Procedure to zero out a portion of buf1 with buf2 and delete buf2;

SIMPLE INTERNAL PROCEDURE IZEROUT(INTEGER BUF1,BUF2);
	RETURN;
! Procedure to make a mask of ones for a region.  It is passed
  an item that has the limit box and vector list associated with
  it along with regions that it contains. 
  It returns a picture buffer with starting corner at IMIN,
  JMIN of the limit box.  These are stored in the header of the
  picture buffer
;
SIMPLE INTERNAL INTEGER PROCEDURE IMSKREG(STRING ITEMVAR XREG);
	RETURN(-1);
! Procedure to make masks out of each separate mask that is found in
  the given mask.  The new masks' file names are found in the value of
  DMASK⊗REGION≡VALUE where all of the regions are found in NEWREGS.
  Note that MSKBUF will be zeroed out in the process.
;
SIMPLE INTERNAL PROCEDURE ISEPMSK(INTEGER MSKBUF;REFERENCE LIST NEWREGS);
	RETURN;
! Procedure to join two masks out right and returns a third buffer
  containing them together.
;
SIMPLE INTERNAL INTEGER PROCEDURE IJNMSK(INTEGER BUF1,BUF2);
	RETURN(-1);
REQUIRE UNSTACK!DELIMITERS;
END "INFBAS";